home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Celestin Apprentice 5
/
Apprentice-Release5.iso
/
Source Code
/
Think Class Libraries
/
CProgressBar 1.2
/
CProgressBar.p
next >
Wrap
Text File
|
1996-01-05
|
16KB
|
560 lines
{****************************************************}
{}
{ CProgressBar.p }
{}
{ SUPERCLASS = CPane }
{}
{ Copyright © 1994 Johns Hopkins University. All rights reserved. }
{}
{ Original Author: Martin R. Wachter email: mrw@welchgate.welch.jhu.edu }
{}
{ Modified: 4/27/94 by: mrw TCL Version: 1.1.3 }
{ Created: 3/25/94 by: mrw TCL Version: 1.1.3 }
{}
{ Pascal Translation: Patrick Hew email: phew@ucc.gu.uwa.edu.au }
{}
{ Modified: 3 Jan 1996 by: phew TCL Version: 1.1.2 }
{ Created: 4 Dec 1994 by: phew TCL Version: 1.1.2 }
{}
{ CProgressBar is a subclass of CPane which emulates the Finder's progress }
{ bar when you copy files. Use it like any other CPane subclass. }
{}
{ Call UpdateProgress with a percentage complete to "animate" the progress }
{ fill area.}
{}
{ You can specify any RGB colors that you want for the background and the fill }
{ bar areas of CProgressBar. Call UseFinderProgressColors to use the same }
{ colors that the Finder uses, or call UseSystemTinges for the System's color }
{ tinges as set by the user in the Color CDEV. }
{}
{ Important: If you creating a progress bar in a DLOG dialog as an overloaded }
{ item, remember to override your application's ForceClassReferences method }
{ to refer to CProgressBar. See CApplication.ForceClassReferences for details. }
{ Thanks to Robert "lobsterman" Huber for detecting this error. }
{}
{ Version change history: }
{ }
{ 1.0 Initial release. }
{ 1.1 FinderFillColor and FinderBackColor declared as separate functions. }
{ This allows Finder colors to be set at the initialization stage. }
{ GetWindowTinges now a utility function instead of being a method. }
{ Removed automatic creation of a frame border. Creating a border is }
{ left to the programmer, being a separate object. }
{ Drawing and UpdateProgress revamped to handle shadowing of the bar }
{ correctly, and to reduce flickering during animation. }
{ 1.2 Restructured into a single file. }
{ Draw now checks for using color (and hence for the presence of Color }
{ Quickdraw) before saving and restoring the foreground colour. }
{}
{****************************************************}
unit CProgressBar;
interface
uses
TCL;
{ Synonyms for certain values. }
const
kDontUseColor = FALSE;
kUseColor = TRUE;
kHorizontal = FALSE;
kVertical = TRUE;
KNoShadow = FALSE;
kShadow = TRUE;
const
SHADOW_DEPTH = 2;
type
CProgressBar = object(CPane)
useShadow: Boolean;
isVertical: Boolean;
useColor: Boolean;
itsRGBFillColor: RGBColor;
itsRGBBackColor: RGBColor;
itsPercent: Integer;
itsFillRect: Rect;
{ Initialize a ProgressBar object. }
procedure IProgressBar (anEnclosure: CView;
aSupervisor: CBureaucrat;
aWidth: Integer;
aHeight: Integer;
aHEncl: Integer;
aVEncl: Integer;
aHSizing: SizingOption;
aVSizing: SizingOption;
aColor: Boolean;
aVertical: Boolean;
aShadow: Boolean;
rgbFColor: RGBColor;
rgbBColor: RGBColor);
{ Initialize a ProgressBar object using a template. }
procedure IViewTemp (anEnclosure: CView;
aSupervisor: CBureaucrat;
viewData: Ptr);
override;
{ Use the same colors that the Finder 's progress bar uses. }
procedure UseFinderProgressColors;
{ Use the System 's Highlight and Window colors for the fill and back colors. }
procedure UseSystemTinges;
{ Draw the Progress bar. }
procedure Draw (var area: Rect);
override;
{ Given a percentage of completion, UpdateProgress will set itsFillRect to the }
{ appropriate size. The Draw method actually draws the fill bar. }
{ Animate the bar by multiple calls to UpdateProgress with different values. }
{ Horizontal growth is from left to right, vertical growth from bottom to top. }
procedure UpdateProgress (percent: Integer);
end; { CProgressBar }
{ ProgressBar template. }
type
ProgressBarTemp = record
sPaneTemp: PaneTemp;
color: Integer; { The template stores a Boolean as two bytes. }
vertical: Integer; { Hence we have to read as an integer/short. }
shadow: Integer;
rgbFColor: RGBColor; { These are just three integers. }
rgbBColor: RGBColor;
end;
ProgressBarTempP = ^ProgressBarTemp;
{ Utility functions for getting colors. }
{ These are generic enough that one may wish to use them elsewhere, }
{ hence they have been unbundled from methods. }
{ Returns the RGB values for the Finder's fill color. }
function FinderFillColor: RGBColor;
{ Returns the RGB values for the Finder's back color. }
function FinderBackColor: RGBColor;
{ Returns the RGB values for the Finder's background color. }
procedure GetWindowTinges (var lightTinge: RGBColor;
var darkTinge: RGBColor);
implementation
{****************************************************}
{}
{ IProgressBar }
{}
{ Initialize a ProgressBar object. }
{}
{****************************************************}
procedure CProgressBar.IProgressBar (anEnclosure: CView;
aSupervisor: CBureaucrat;
aWidth: Integer;
aHeight: Integer;
aHEncl: Integer;
aVEncl: Integer;
aHSizing: SizingOption;
aVSizing: SizingOption;
aColor: Boolean;
aVertical: Boolean;
aShadow: Boolean;
rgbFColor: RGBColor;
rgbBColor: RGBColor);
begin { IProgressBar }
IPane(anEnclosure, aSupervisor, aWidth, aHeight, aHEncl, aVEncl, aHSizing, aVSizing);
useColor := aColor & gSystem.hasColorQD;
isVertical := aVertical;
useShadow := aShadow;
itsRGBFillColor := rgbFColor;
itsRGBBackColor := rgbBColor;
itsPercent := 0;
end; { IProgressBar }
{****************************************************}
{}
{ IViewTemp }
{}
{ Initialize a ProgressBar object using a template. }
{}
{****************************************************}
procedure CProgressBar.IViewTemp (anEnclosure: CView;
aSupervisor: CBureaucrat;
viewData: Ptr);
var
p: ProgressBarTempP;
begin { IViewRes }
p := ProgressBarTempP(viewData);
{ Initialize superclass. }
inherited IViewTemp(anEnclosure, aSupervisor, @p^.sPaneTemp);
{ Set instance variables from template. }
useColor := (p^.color <> 0) & gSystem.hasColorQD;
isVertical := p^.vertical <> 0;
useShadow := p^.shadow <> 0;
itsRGBFillColor := p^.rgbFColor;
itsRGBBackColor := p^.rgbBColor;
itsPercent := 0;
end; { IViewRes }
{****************************************************}
{}
{ UseFinderProgressColors }
{}
{ Use the same colors that the Finder 's progress bar uses. }
{}
{****************************************************}
procedure CProgressBar.UseFinderProgressColors;
begin { UseFinderProgressColors }
itsRGBFillColor := FinderFillColor;
itsRGBBackColor := FinderBackColor;
end; { UseFinderProgressColors }
{****************************************************}
{}
{ UseSystemTinges }
{}
{ Use the System 's Highlight and Window colors for the fill and back colors. }
{}
{****************************************************}
procedure CProgressBar.UseSystemTinges;
var
theBackColor, theFillColor: RGBColor;
begin { UseSystemTinges }
{ Note that we can't pass itsRGBBackColor and itsRGBFillColor to GetWindowTinges by reference. }
GetWindowTinges(theBackColor, theFillColor);
itsRGBBackColor := theBackColor;
itsRGBFillColor := theFIllColor;
end; { UseSystemTinges }
{****************************************************}
{}
{ Draw }
{}
{ Draw the Progress bar. }
{}
{****************************************************}
procedure CProgressBar.Draw (var area: Rect);
var
pen: PenState;
frameLR: LongRect;
frameR, theFillR, paintR: Rect;
savForeColor, nowColor, myBlackColor: RGBColor;
begin { Draw }
GetFrame(frameLR);
LongToQDRect(frameLR, frameR);
Prepare;
GetPenState(pen);
if useColor then begin
GetForeColor(savForeColor);
end; { if }
PenNormal;
{ Paint the background. }
if SectRect(frameR, area, paintR) then begin
if useColor then begin
nowColor := itsRGBBackColor;
RGBForeColor(nowColor);
end { if }
else begin
PenPat(white);
end; { else if }
PaintRect(paintR);
end; { if }
{ Paint the fill area. }
theFillR := itsFillRect;
if SectRect(theFillR, area, paintR) then begin
if useColor then begin
nowColor := itsRGBFillColor;
RGBForeColor(nowColor);
end { if }
else begin
PenPat(gray);
end; { if }
PaintRect(paintR);
end; { if }
if useShadow & (itsPercent > 0) then begin
if useColor then begin
{ The identifier BlackColor is used by QuickDraw for something different. }
with myBlackColor do begin
red := $0000;
green := $0000;
blue := $0000;
end; { with }
RGBForeColor(myBlackColor);
end { if }
else begin
PenPat(black);
end; { else }
{ Recall that drawing is clipped to the pane of the frame. }
{ itsFillRect is correctly sized in UpdateProgress. }
PenSize(SHADOW_DEPTH, SHADOW_DEPTH);
MoveTo(itsFillRect.left + SHADOW_DEPTH, itsFillRect.bottom);
LineTo(itsFillRect.right, itsFillRect.bottom);
LineTo(itsFillRect.right, itsFillRect.top + SHADOW_DEPTH);
end; { if }
{ Reset settings. }
SetPenState(pen);
if useColor then begin
RGBForeColor(savForeColor);
end; { if }
end; { Draw }
{****************************************************}
{}
{ UpdateProgress }
{}
{ Given a percentage of completion, UpdateProgress will set itsFillRect to the }
{ appropriate size. The Draw method actually draws the fill bar. }
{}
{ Animate the bar by multiple calls to UpdateProgress with different values. }
{ Horizontal growth is from left to right, vertical growth from bottom to top. }
{}
{****************************************************}
procedure CProgressBar.UpdateProgress (percent: Integer);
var
theFillRect, updateRect: Rect;
rectWidth, rectHeight, barFill, oldFill: Integer;
begin { UpdateProgress }
{ Update only if there is a change. }
if itsPercent <> percent then begin
GetLengths(rectWidth, rectHeight);
if not isVertical then begin
{ We calculate barFill using integer processes to avoid numerical errors. }
{ However, multiplying rectWidth by percent may result in an overflow }
{ so we cast to LongInt first, then work back. }
barFill := Integer(LongInt(rectWidth) * LongInt(percent) div 100);
oldFill := Integer(LongInt(rectWidth) * LongInt(itsPercent) div 100);
{ Growth from left to right. For intersection testing, work with respect to frame co-ordinates. }
if percent > itsPercent then begin
SetRect(updateRect, oldFill, 0, barFill, rectHeight);
end { if }
else begin
SetRect(updateRect, barFill, 0, oldFill, rectHeight);
end; { else }
{ If there is to be a shadow, define the bar width so that we can see it. }
if useShadow then begin
SetRect(theFillRect, 0, 0, barFill, rectHeight - SHADOW_DEPTH);
end { if }
else begin
SetRect(theFillRect, 0, 0, barFill, rectHeight);
end; { else }
end { if }
else begin
{ We calculate barFill using integer processes to avoid numerical errors. }
{ However, multiplying rectHeight by percent may result in in an overflow }
{ so we cast to LongInt first, then work back. }
barFill := Integer(LongInt(rectHeight) * LongInt(percent) div 100);
oldFill := Integer(LongInt(rectHeight) * LongInt(itsPercent) div 100);
{ Growth from top to bottom. }
if percent > itsPercent then begin
SetRect(updateRect, 0, rectHeight - barFill, rectWidth, rectHeight - oldFill);
end { if }
else begin
SetRect(updateRect, 0, rectHeight - oldFill, rectWidth, rectHeight - barFill);
end; { else }
{ If there is to be a shadow, define the bar height so that we can see it. }
if useShadow then begin
SetRect(theFillRect, 0, rectHeight - barFill, rectWidth - SHADOW_DEPTH, rectHeight);
end { if }
else begin
SetRect(theFillRect, 0, rectHeight - barFill, rectWidth, rectHeight);
end; { else }
end; { else }
{ Remember - Never pass an instance variable as a parameter by reference, }
{ unless you are absolutely sure that no memory is going to be shifted. }
{ We can remove any doubt by using theFillRect as a temporary variable. }
itsFillRect := theFillRect;
itsPercent := percent;
Draw(updateRect);
end; { if }
end; { UpdateProgress }
{****************************************************}
{}
{ FinderFillColor }
{}
{ Returns the RGB values for the Finder's fill color. }
{}
{****************************************************}
function FinderFillColor: RGBColor;
var
theColor: RGBColor;
begin { FinderFillColor }
with theColor do begin
red := 17476;
green := 17476;
blue := 17476;
end; { with }
FinderFillColor := theColor;
end; { FinderFillColor }
{****************************************************}
{}
{ FinderBackColor }
{}
{ Returns the RGB values for the Finder's back color. }
{}
{****************************************************}
function FinderBackColor: RGBColor;
var
theColor: RGBColor;
begin { FinderBackColor }
with theColor do begin
red := Integer(52428);
green := Integer(52428);
blue := Integer(65535);
end; { with }
FinderBackColor := theColor;
end; { FinderBackColor }
{****************************************************}
{}
{ GetWindowTinges }
{}
{ Returns the RGB values for the Finder's background color. }
{}
{****************************************************}
procedure GetWindowTinges (var lightTinge: RGBColor;
var darkTinge: RGBColor);
var
windowCTable: CTabHandle;
begin { GetWindowTinges }
{ Get the current colour lookup table. }
windowCTable := CTabHandle(GetResource('wctb', 0));
if windowCTable <> nil then begin
{ Note about compiler directives - ctTable is of }
{ type CSpecArray, which has array indices 0..0 }
{ However, if the resource is not nil, then we know }
{ that we can retrieve the colors that we want by }
{ accessing indices 11 and 12. }
{ Is there is a way to do this more cleanly? }
{$PUSH}
{$R-}
lightTinge := windowCTable^^.ctTable[11].rgb;
darkTinge := windowCTable^^.ctTable[12].rgb;
{$POP}
{ Case for black and white window defs under system 7, both return black! }
with lightTinge do begin
if (red = $0000) & (green = $0000) & (blue = $0000) then begin
red := $ffff;
green := $ffff;
blue := $ffff;
end; { if }
end; { with }
end { if }
else begin
{ No window colour table, make black and white. }
with lightTinge do begin
red := $ffff;
green := $ffff;
blue := $ffff;
end; { with }
with darkTinge do begin
red := $0000;
green := $0000;
blue := $0000;
end; { with }
end; { else }
end; { GetWindowTinges }
end. { CProgressBar }
